home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / skk / skk-num.el.z / skk-num.el
Encoding:
Text File  |  1998-05-21  |  22.7 KB  |  495 lines
  1. ;;; skk-num.el --- $B?tCMJQ49$N$?$a$N%W%m%0%i%`(B
  2. ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997
  3. ;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
  4.  
  5. ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
  6. ;; Maintainer: Mikio Nakajima <minakaji@osaka.email.ne.jp>
  7. ;; Version: $Id: skk-num.el,v 1.2 1997/08/24 15:25:55 mrt Exp $
  8. ;; Keywords: japanese
  9. ;; Last Modified: $Date: 1997/08/24 15:25:55 $
  10.  
  11. ;; This program is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either versions 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; This program is distributed in the hope that it will be useful
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with SKK, see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston,
  24. ;; MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;;; Change log:
  29.  
  30. ;; Following people contributed modifications to skk.el (Alphabetical order):
  31. ;;      Hideki Sakurada <sakurada@kuis.kyoto-u.ac.jp>
  32. ;;      Manabu Kawashima <kaw@lp.nm.fujitsu.co.jp>
  33.  
  34. ;;; TODO
  35. ;; (1)skk-kanji-num-str2-subr $B$N%P%0=$@5!#(Bskk-kanji-num-str2-subr $B$N%3%a%s%H;2>H(B
  36. ;;    $B$N$3$H!#(B
  37. ;;
  38. ;; (2)skk-kanji-num-str3 $B$N?7@_!#(B
  39.  
  40. ;;; Code:
  41. (require 'skk-foreword)
  42. (require 'skk-vars)
  43. (require 'cl)
  44.  
  45. ;; user variables.
  46. ;;;###skk-autoload
  47. (defvar skk-num-type-list
  48.   '((?0 . identity)
  49.     (?1 . skk-zenkaku-num-str)
  50.     (?2 . skk-kanji-num-str)
  51.     (?3 . skk-kanji-num-str2)
  52.     ;;(?5 . skk-kanji-num-str3) ; $B=`HwCf(B
  53.     (?4 . skk-recompute-numerals)
  54.     (?9 . skk-shogi-num-str) )
  55.   "*$B?t;z$NJQ49$N$?$a$N!"%$%s%G%/%9$HJQ49$K;HMQ$9$k4X?t$H$N%I%C%H%Z%"$N%j%9%H!#(B
  56. $B3FMWAG$O!"(B($B?t;z$N(B char-type . $B4X?tL>(B) $B$H$$$&9=@.$K$J$C$F$$$k!#(B
  57. car $BItJ,$O!"Nc$($P!"8+=P$78l$,(B \"$BJ?@.(B#1$BG/(B\" $B$N$H$-!"(B# $B5-9f$ND>8e$KI=<($5$l$k?t(B
  58. $B;z(B \"1\" $B$r(B char-type $B$GI=$o$7$?$b$N$rBeF~$9$k!#(B")
  59.  
  60. (defvar skk-numeric-conversion-float-num nil
  61.   "*Non-nil $B$G$"$l$P!"IbF0>.?tE@?t$r;H$C$?8+=P$78l$KBP1~$7$FJQ49$r9T$J$&!#(B
  62. $B$3$NCM$r(B non-nil $B$K$9$k$3$H$G!"(B\"#.# /#1$B!%(B#1/#0$B7n(B#0$BF|(B/\" $B$J$I$N<-=q8+=P$7$,;HMQ(B
  63. $B$G$-$J$/$J$k$N$G!"Cm0U!#(B" )
  64.  
  65. ;;;###skk-autoload
  66. (defvar skk-uniq-numerals (or (assq ?4 skk-num-type-list)
  67.                                   (and (assq ?2 skk-num-type-list)
  68.                                        (assq ?3 skk-num-type-list) ))
  69.   "*Non-nil $B$G$"$l$P!"0[$J$k?tCMI=8=$G$bJQ497k2L$,F1$8?tCM$r=EJ#$7$F=PNO$7$J$$!#(B" )
  70.  
  71. (defvar skk-num-load-hook nil
  72.   "*skk-num.el $B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#(B" )
  73.  
  74. ;; internal constants and variables
  75. (defconst skk-num-alist-type1
  76.   '((?0 . "$B#0(B") (?1 . "$B#1(B") (?2 . "$B#2(B") (?3 . "$B#3(B")
  77.     (?4 . "$B#4(B") (?5 . "$B#5(B") (?6 . "$B#6(B") (?7 . "$B#7(B")
  78.     (?8 . "$B#8(B") (?9 . "$B#9(B")
  79.     (?. . "$B!%(B") ; $B>.?tE@!#(B(?. . ".") $B$NJ}$,NI$$?M$b$$$k$+$b(B...$B!#(B
  80.     (?  . "") )
  81.   "ascii $B?t;z$N(B char type $B$HA43Q?t;z$N(B string type $B$NO"A[%j%9%H!#(B
  82. \"1995\" -> \"$B#1#9#9#5(B\" $B$N$h$&$JJ8;zNs$NJQ49$r9T$&:]$KMxMQ$9$k!#(B" )
  83.  
  84. (defconst skk-num-alist-type2
  85.   '((?0 . "$B!;(B") (?1 . "$B0l(B") (?2 . "$BFs(B") (?3 . "$B;0(B")
  86.     (?4 . "$B;M(B") (?5 . "$B8^(B") (?6 . "$BO;(B") (?7 . "$B<7(B")
  87.     (?8 . "$BH,(B") (?9 . "$B6e(B") (?  . "") )
  88.   "ascii $B?t;z$N(B char type $B$H4A?t;z$N(B string type $B$NO"A[%j%9%H!#(B
  89. \"1995\" -> \"$B0l6e6e8^(B\" $B$N$h$&$JJ8;zNs$NJQ49$r9T$&:]$KMxMQ$9$k!#(B" )
  90.  
  91. ;;; $B=`HwCf(B
  92. ;;;(defconst skk-num-alist-type3
  93. ;;;  '((?1 . "$B0m(B") (?2 . "$BFu(B") (?3 . "$B;2(B")
  94. ;;;    (?4 . "$B;M(B") (?5 . "$B8`(B") (?6 . "$BO;(B") (?7 . "$B<7(B")
  95. ;;;    (?8 . "$BH,(B") (?9 . "$B6e(B") (?  . "") )
  96. ;;;  "ascii $B?t;z$N(B char type $B$H4A?t;z$N(B string type $B$NO"A[%j%9%H!#(B
  97. ;;;\"1995\" -> \"$B0mot6eI46e=&8`(B\" $B$N$h$&$JJ8;zNs$NJQ49$r9T$&:]$KMxMQ$9$k!#(B" )
  98.  
  99. ;;;###skk-autoload
  100. (skk-deflocalvar skk-num-list nil
  101.   "skk-henkan-key $B$NCf$K4^$^$l$k?t;z$rI=$9J8;zNs$N%j%9%H!#(B
  102. $BNc$($P!"(B\"$B"&$X$$$;$$(B7$B$M$s(B10$B$,$D(B\" $B$NJQ49$r9T$&$H$-!"(Bskk-henkan-key $B$O(B
  103. \"$B$X$$$;$$(B7$B$M$s(B10$B$,$D(B\" $B$G$"$j!"(Bskk-num-list $B$O(B \(\"7\" \"10\"\) $B$H$J$k!#(B" )
  104.  
  105. ;;;###skk-autoload
  106. (skk-deflocalvar skk-recompute-numerals-key nil
  107.   "#4 $B%?%$%W$N%-!<$K$h$j?tCM$N:F7W;;$r9T$J$C$?$H$-$N8!:w%-!<!#(B" )
  108.  
  109. ;;;###skk-autoload
  110. (defun skk-compute-numeric-henkan-key (key)
  111.   ;; KEY $B$NCf$NO"B3$9$k?t;z$r8=$o$9J8;zNs$r(B "#" $B$KCV$-49$($?J8;zNs$rJV$9!#(B"12"
  112.   ;; $B$d(B "$B#0#9(B" $B$J$IO"B3$9$k?t;z$r(B 1 $B$D$N(B "#" $B$KCV$-49$($k$3$H$KCm0U!#(B
  113.   ;; $BCV$-49$($??t;z$r(B skk-num-list $B$NCf$K%j%9%H$N7A$GJ]B8$9$k!#(B
  114.   ;; $BNc$($P!"(BKEY $B$,(B "$B$X$$$;$$(B7$BG/(B12$B$,$D(B" $B$G$"$l$P!"(B"$B$X$$$;$$(B#$B$M$s(B#$B$,$D(B"
  115.   ;; $B$HJQ49$7!"(Bskk-num-list $B$K(B ("7" "12") $B$H$$$&%j%9%H$rBeF~$9$k!#(B
  116.   ;; $B<-=q$N8+=P$78l$N8!:w$K;HMQ$9$k!#(B
  117.   (let ((numberrep (if skk-numeric-conversion-float-num
  118.                        "[.0-9]+" "[0-9]+" ))
  119.         (enable-multibyte-characters t) )
  120.     ;;(setq skk-noconv-henkan-key key)
  121.     (save-match-data
  122.       ;; $BA43Q?t;z$r(B ascii $B?t;z$KJQ49$9$k!#(B
  123.       (while (string-match "[$B#0(B-$B#9(B]" key)
  124.         (let ((zen-num (match-string 0 key)))
  125.           (setq key (concat (substring key 0 (match-beginning 0))
  126.                             (skk-jisx0208-to-ascii zen-num)
  127.                             (substring key (match-end 0)) ))))
  128.       ;; ascii $B?t;z$r(B "#" $B$KCV$-49$(!"$=$N?t;z$r(B skk-num-list $B$NCf$KJ]B8!#(B
  129.       (while (string-match numberrep key)
  130.         (setq skk-num-list (nconc skk-num-list (list (match-string 0 key)))
  131.               key (concat (substring key 0 (match-beginning 0))
  132.                           "#"
  133.                           (substring key (match-end 0)) )))))
  134.   key )
  135.  
  136. ;;(defun skk-compute-noconv-henkan-key (key)
  137. ;;  ;; $BJ8;zNs(B KEY $B$NCf$K?tCMJQ49$rI=$o$9(B "#" $B$,$"$l$P!"$=$NItJ,$r:o=|$7!"(B
  138. ;;  ;; skk-num-list $B$NCf$G3:Ev$9$k?t;z$rA^F~$7!":G=i$K(B skk-start-henkan $B$KEO$5$l(B
  139. ;;  ;; $B$?J8;zNs$rJV$9!#Nc$($P!"(Bskk-num-list $B$,(B ("1" "2" "3") $B$G!"(BKEY $B$,(B
  140. ;;  ;; "#$B$,$D(B#$B$,$D(B#$B$,$D(B" $B$G$"$k$H$-$O!"J8;zNs(B "1$B$,$D(B2$B$,$D(B3$B$,$D(B" $B$rJV$9!#(B
  141. ;;  (if skk-num-list
  142. ;;      (save-match-data
  143. ;;        (let ((num-list skk-num-list)
  144. ;;              str )
  145. ;;          (while (and num-list key (string-match "#" key))
  146. ;;            (setq str (concat str (substring key 0 (match-beginning 0))
  147. ;;                              (car num-list) )
  148. ;;                  key (substring key (match-end 0))
  149. ;;                  num-list (cdr num-list) ))
  150. ;;          (setq key (concat str key)) )))
  151. ;;  key )
  152.  
  153. ;;;###skk-autoload
  154. (defun skk-numeric-convert (key)
  155.   (if (not key)
  156.       nil
  157.     (let ((numexp (if skk-numeric-conversion-float-num
  158.                       "#[.0-9]+" "#[0-9]+" ))
  159.           (n 0)
  160.           (workkey key)
  161.           num convnum string convlist current )
  162.       (save-match-data
  163.         (while (and (setq num (nth n skk-num-list))
  164.                     (string-match numexp workkey) )
  165.           (setq convnum (skk-num-exp num (string-to-char
  166.                                           (substring workkey
  167.                                                      (1+ (match-beginning 0))
  168.                                                      (match-end 0) )))
  169.                 string (substring workkey 0 (match-beginning 0))
  170.                 workkey (substring workkey (match-end 0))
  171.                 n (1+ n) )
  172.           (if (not (and (stringp convnum) (string= convnum "")
  173.                         (string= string "") ))
  174.               (setq convlist (nconc convlist (list string convnum))) ))
  175.         (setq convlist (nconc convlist (list workkey)))
  176.         (cond ((null convlist) nil)
  177.               ((and (null (cdr convlist)) (stringp (car convlist)))
  178.                (setq current (car convlist)) )
  179.               ;; RAW-LIST $B$NA4MWAG$,J8;zNs!#(B
  180.               ((null (memq t (mapcar 'listp convlist)))
  181.                (setq current (mapconcat 'identity convlist ""))
  182.                (if (and (> skk-henkan-count -1)
  183.                         (nth skk-henkan-count skk-henkan-list) )
  184.                    ;; ("A" "#2" "C") -> ("A" ("$B0l(B" . "#2") "C")
  185.                    (setf (nth skk-henkan-count skk-henkan-list)
  186.                          (cons key current) )
  187.                  (setq skk-henkan-list
  188.                        (nconc skk-henkan-list (list (cons key current))) )))
  189.               ;; #4
  190.               (t (let ((l (mapcar (function (lambda (e) (cons key e)))
  191.                                   (skk-flatten-list (delete "" convlist)) )))
  192.                    (setq current (cdr (car l)))
  193.                    (if (and (> skk-henkan-count -1)
  194.                             (nth skk-henkan-count skk-henkan-list) )
  195.                        (progn
  196.                          (setf (nth skk-henkan-count skk-henkan-list) (car l))
  197.                          (setq skk-henkan-list (skk-middle-list
  198.                                                 skk-henkan-list
  199.                                                 (1+ skk-henkan-count)
  200.                                                 (cdr l) )))
  201.                      (setq skk-henkan-list (nconc skk-henkan-list l)) ))))
  202.         current ))))
  203.  
  204. ;;;###skk-autoload
  205. (defun skk-numeric-convert*7 ()
  206.   (let ((skk-henkan-count skk-henkan-count)
  207.         (n 7) )
  208.     (while (and (> n 0) (nth skk-henkan-count skk-henkan-list))
  209.       (skk-numeric-convert (skk-get-current-candidate))
  210.       (setq skk-henkan-count (1+ skk-henkan-count)
  211.             n (1- n) ))
  212.     (if skk-recompute-numerals-key
  213.         (skk-uniq-numerals) )))
  214.  
  215. (defun skk-raw-number-to-skk-rep (string)
  216.   (setq string (skk-raw-number-to-skk-rep-1
  217.                 string "[$B#0(B-$B#9(B][$B0l6e8^;0;M<7FsH,O;(B]" "#9" 0 ))
  218.   (setq string (skk-raw-number-to-skk-rep-1
  219.                 string "\\(^\\|[^#0-9]\\)\\([0-9]+\\)" "#0" 2 ))
  220.   (setq string (skk-raw-number-to-skk-rep-1
  221.                 string "[$B#0(B-$B#9(B]+" "#1" 0 ))
  222.   (setq string (skk-raw-number-to-skk-rep-1
  223.                 string "\\([$B0l6e8^;0;M<7FsH,O;==(B][$B==I4@iK|2/C{5~(B]\\)+" "#3" 0 ))
  224.   ;; (mapcar 'char-to-string
  225.   ;;         (sort
  226.   ;;          '(?$B0l(B ?$BFs(B ?$B;0(B ?$B;M(B ?$B8^(B ?$BO;(B ?$B<7(B ?$BH,(B ?$B6e(B ?$B!;(B) '<))
  227.   ;;   --> ("$B!;(B" "$B0l(B" "$B6e(B" "$B8^(B" "$B;0(B" "$B;M(B" "$B<7(B" "$BFs(B" "$BH,(B" "$BO;(B")
  228.   ;;
  229.   ;; [$B!;(B-$B6e(B] $B$H$$$&@55,I=8=$,;H$($J$$$N$G!"@8$N$^$^$D$C$3$s$G$*$/!#(B
  230.   (skk-raw-number-to-skk-rep-1 string "[$B!;0l6e8^;0;M<7FsH,O;(B]+" "#2" 0))
  231.  
  232. (defun skk-raw-number-to-skk-rep-1 (string key type place)
  233.   (let ((enable-multibyte-characters t))
  234.     (save-match-data
  235.       (while (string-match key string)
  236.         (setq string (concat (substring string 0 (match-beginning place))
  237.                              type
  238.                              (substring string (match-end place)) )))
  239.     string )))
  240.   
  241. (defun skk-flatten-list (list)
  242.   ;; $BM?$($i$l$?%j%9%H$N3FMWAG$+$iAH$_9g$;2DG=$JJ8;zNs$NO"@\$r:n$j!"%j%9%H$GJV(B
  243.   ;; $B$9!#(B
  244.   ;; (("A" "B") "1" ("X" "Y")) -> ("A1X" "A1Y" "B1X" "B1Y")
  245.   (do ((result
  246.         (if (atom (car list)) (list (car list)) (car list))
  247.         (mapcan (function
  248.                  (lambda (a)
  249.                    (mapcar (function (lambda (b) (concat a b)))
  250.                            (if (atom (car tail)) (list (car tail))
  251.                              (car tail) ))))
  252.                 result ))
  253.        (tail (cdr list) (cdr tail)) )
  254.       ((null tail) result) ))
  255.  
  256. (defun skk-num-exp (num type)
  257.   ;; ascii $B?t;z$N(B NUM $B$r(B TYPE $B$K=>$$JQ49$7!"JQ498e$NJ8;zNs$rJV$9!#(B
  258.   ;; TYPE $B$O2<5-$NDL$j!#(B
  259.   ;; 0 -> $BL5JQ49(B
  260.   ;; 1 -> $BA43Q?t;z$XJQ49(B
  261.   ;; 2 -> $B4A?t;z$XJQ49(B
  262.   ;; 3 -> $B4A?t;z$XJQ49(B ($B0L<h$j$r$9$k(B)
  263.   ;; 4 -> $B$=$N?t;z$=$N$b$N$r%-!<$K$7$F<-=q$r:F8!:w(B
  264.   ;; 9 -> $B>-4}$G;HMQ$9$k?t;z(B ("$B#3;M(B" $B$J$I(B) $B$KJQ49(B
  265.   (let ((fun (cdr (assq type skk-num-type-list))))
  266.     (if fun (funcall fun num)) ))
  267.  
  268. (defun skk-zenkaku-num-str (num)
  269.   ;; ascii $B?t;z$N(B NUM $B$rA43Q?t;z$NJ8;zNs$KJQ49$7!"JQ498e$NJ8;zNs$rJV$9!#(B
  270.   ;; $BNc$($P(B "45" $B$r(B "$B#4#5(B" $B$KJQ49$9$k!#(B
  271.   (let ((candidate
  272.          (mapconcat (function (lambda (c) (cdr (assq c skk-num-alist-type1))))
  273.                     num "" )))
  274.     (if (not (string= candidate ""))
  275.         candidate )))
  276.  
  277. (defun skk-kanji-num-str (num)
  278.   ;; ascii $B?t;z(B NUM $B$r4A?t;z$NJ8;zNs$KJQ49$7!"JQ498e$NJ8;zNs$rJV$9!#(B
  279.   ;; $BNc$($P!"(B"45" $B$r(B "$B;M8^(B" $B$KJQ49$9$k!#(B
  280.   (save-match-data
  281.     (if (not (string-match "\\.[0-9]" num))
  282.         (let ((candidate
  283.                (mapconcat (function (lambda (c)
  284.                                       (cdr (assq c skk-num-alist-type2)) ))
  285.                           num "" )))
  286.           (if (not (string= candidate ""))
  287.               candidate )))))
  288.  
  289. (defun skk-kanji-num-str2 (num)
  290.   ;; ascii $B?t;z(B NUM $B$r4A?t;z$NJ8;zNs$KJQ49$7(B ($B0L<h$j$r$9$k(B)$B!"JQ498e$NJ8;zNs$r(B
  291.   ;; $BJV$9!#Nc$($P(B "1021" $B$r(B "$B@iFs==0l(B" $B$KJQ49$9$k!#(B
  292.   (save-match-data
  293.     (if (not (string-match "\\.[0-9]" num))
  294.         (let ((str (skk-kanji-num-str2-subr num)))
  295.           (if (string= "" str) "$B!;(B" str) ))))
  296.  
  297. (defun skk-kanji-num-str2-subr (num)
  298.   ;; skk-kanji-num-str2 $B$N%5%V%k!<%A%s!#(B
  299.   ;;
  300.   ;; Known Bug; $B"&(B 100000000 $B$rJQ49$9$k$H!"(B"$B0l2/K|(B" $B$K$J$C$F$7$^$&(B...$B!#$G$b$=$s(B
  301.   ;; $B$JJQ49$r;H$&?M$O$$$J$$$+$J!"$H;W$&$HD>$95$NO$,M/$+$J$$(B...$B!#(B
  302.   ;; --> Fixed $B$N%O%:(B...$B!#(B
  303.   (let ((len (length num))
  304.         prevchar modulo )
  305.     (mapconcat
  306.      (function
  307.       (lambda (char)
  308.         ;; $B0L(B:     $B0l(B   $B==(B    $BI4(B     $B@i(B  $BK|(B   $B==K|(B   $BI4K|(B   $B@iK|(B    $B2/(B
  309.         ;; modulo: 1 --> 2 --> 3 --> 0 -> 1 --> 2 ---> 3 ---> 0 ---> 1
  310.         (setq modulo (mod len 4))
  311.         (prog1
  312.             (if (eq len 1)
  313.                 ;; 1 $B7e$G(B 0 $B$G$J$$?t!#(B
  314.                 (if (not (eq char ?0))  ;?0
  315.                     ;; $B0L$rI=$o$94A?t;z0J30$N4A?t;z!#(B
  316.                     (cdr (assq char skk-num-alist-type2)) )
  317.               (concat
  318.                ;; $B0L$rI=$o$94A?t;z0J30$N4A?t;z!#(B
  319.                (if (or
  320.                     ;; 2 $B7e0J>e$G!"$3$N0L$N?t$O(B 0, 1 $B0J30$N?t;z!#(B
  321.                     ;; ?0 == 48, ?1 == 49
  322.                     (null (memq char '(?0 ?1)))
  323.                     ;; 2 $B7e0J>e$G!"$3$N0L$N?t$O(B 1 $B$G!"0L$,$=$N0L$rI=$o$94A?t;z(B
  324.                     ;; $B$K(B "$B0l(B" $B$rJ;5-$9$Y$-(B ($BNc$($P!"(B"$B0l2/(B" $B$J$I!#(B"$B2/(B" $B$G$O$*(B
  325.                     ;; $B$+$7$$(B) $B$H$-!#(B
  326.                     (and (eq char ?1) (eq modulo 1)) )
  327.                    (cdr (assq char skk-num-alist-type2)) )
  328.                ;; $B0L$rI=$o$94A?t;z!#(B
  329.                (if (and (not (eq prevchar ?0))
  330.                         (not (and (eq char ?0) (not (eq modulo 1))) ))
  331.                    (cond ((cdr (assq modulo '((2 . "$B==(B") (3 . "$BI4(B") (0 . "$B@i(B")))))
  332.                          ((cdr (assq len '((5 . "$BK|(B") (9 . "$B2/(B") (13 . "$BC{(B")
  333.                                            (17 . "$B5~(B") ))))
  334.                          (t (skk-error "$B7e$,Bg$-$9$.$^$9!*(B"
  335.                                        "Too big number!" ))))))
  336.           (setq len (1- len)
  337.                 prevchar char ) )))
  338.      num "" )))
  339.  
  340. (defun skk-shogi-num-str (num)
  341.   ;; ascii $B?t;z$N(B NUM $B$r>-4}$G;HMQ$5$l$k?t;zI=5-$KJQ49$9$k!#(B
  342.   ;; $BNc$($P(B "34" $B$r(B "$B#3;M(B" $B$KJQ49$9$k!#(B
  343.   (save-match-data
  344.     (if (and (eq (length num) 2)
  345.              (not (string-match "\\.[0-9]" num)) )
  346.         (let ((candidate
  347.                (concat (cdr (assq (aref num 0) skk-num-alist-type1))
  348.                        (cdr (assq (aref num 1) skk-num-alist-type2)) )))
  349.           (if (not (string= candidate ""))
  350.               candidate )))))
  351.  
  352. (defun skk-recompute-numerals (num)
  353.   ;; #4 $B$N8+=P$7$KBP$7!"(Bskk-henkan-key $B$KBeF~$5$l$??t;z$=$N$b$N$r:FEY8!:w$9$k!#(B
  354.   (let (result)
  355.     ;; with-temp-buffer $B$@$H2?8N>e<j$/$f$+$J$$(B...$B!)(B $B3NDj$5$l$F$7$^$&!#(B
  356.     ;;(with-temp-buffer
  357.     (save-excursion
  358.       (set-buffer (get-buffer-create " *skk-work*"))
  359.       ;; $B%+%l%s%H%P%C%U%!$N%P%C%U%!%m!<%+%kJQ?t$K1F6A$r5Z$\$5$J$$$h$&!"%o!<%-(B
  360.       ;; $B%s%0%P%C%U%!$X0lC6F($2$k(B
  361.       (let ((skk-current-search-prog-list skk-search-prog-list)
  362.             (skk-henkan-key num)
  363.             skk-henkan-okurigana skk-okuri-char skk-use-numeric-conversion )
  364.         ;; $B%+%l%s%H$NJQ49$OAw$j$J$7(B (skk-henkan-okurigana $B$H(B skk-okuri-char $B$O(B
  365.         ;; $B$$$:$l$b(B nil) $B$@$,!"JL%P%C%U%!(B (work $B%P%C%U%!(B) $B$KF~$C$F$$$k$N$G!"G0(B
  366.         ;; $B$N$?$a!"(Bnil $B$rF~$l$F$*$/!#(B
  367.         (while skk-current-search-prog-list
  368.           (setq result (skk-nunion result (skk-search))) )))
  369.     ;; $B$3$3$G(B with-temp-buffer $B$r=P$FJQ49$r9T$J$C$F$$$k%+%l%s%H%P%C%U%!$KLa$k(B
  370.     ;; ($B%P%C%U%!%m!<%+%kCM$G$"$k(B skk-henkan-list $B$rA`:n$7$?$$$?$a(B)$B!#(B
  371.     (setq skk-recompute-numerals-key num)
  372.     (if result
  373.         (if (null (cdr result)) ;;(eq (length result) 1)
  374.             (car result)
  375.           result )
  376.       ;; $BJQ49$G$-$J$+$C$?$i85$N?t;z$r$=$N$^$^JV$7$F$*$/!#(B
  377.       num )))
  378.  
  379. ;;;###skk-autoload
  380. (defun skk-uniq-numerals ()
  381.   (if (or (not skk-uniq-numerals) (null skk-henkan-list))
  382.       nil
  383.     (save-match-data
  384.       (let ((n1 -1) n2 e1 e2 e3
  385.             ;; 1 $B$D$G$b(B 2 $B7e0J>e$N?t;z$,$"$l$P!"(B#2 $B$H(B #3 $B$G$O(B uniq $B$7$J$$!#(B
  386.             (type2and3 (> 2 (apply 'max (mapcar 'length skk-num-list))))
  387.             type2 type3 index2 index3 head2 head3 tail2 tail3
  388.             kanji-flag mc-flag enable-multibyte-characters case-fold-search )
  389.         (while (setq n1 (1+ n1) e1 (nth n1 skk-henkan-list))
  390.           ;; cons cell $B$G$J$1$l$P(B skk-nunion $B$G=hM}:Q$_$J$N$G!"=EJ#$O$J$$!#(B
  391.           (if (consp e1)
  392.               ;; (car e1) $B$H(B equal $B$N$b$N$,>C$($k$N$@$+$i(B e1 $B<+?H$,>C$($k$3(B
  393.               ;; $B$H$O$J$$!#(B
  394.               (setq skk-henkan-list (delete (car e1) skk-henkan-list)
  395.                     skk-henkan-list (delete (cdr e1) skk-henkan-list) ))
  396.           (if (not (and skk-recompute-numerals-key (consp e1)))
  397.               nil
  398.             ;; ("#4" . "xxx") $B$r4^$`8uJd$,(B skk-henkan-list $B$NCf$K$"$k!#(B
  399.             (setq n2 -1)
  400.             (while (setq n2 (1+ n2) e2 (nth n2 skk-henkan-list))
  401.               (if (and (not (= n1 n2)) (consp e2)
  402.                        ;; $BNc$($P(B ("#4" . "$B0l(B") $B$H(B ("#2" . "$B0l(B") $B$,JBB8$7$F$$(B
  403.                        ;; $B$k>l9g!#(B
  404.                        (string= (cdr e1) (cdr e2)) )
  405.                   (setq skk-henkan-list (delq e2 skk-henkan-list)) )))
  406.           (if (not type2and3)
  407.               nil
  408.             ;; 1 $B7e$N?t;z$rJQ49$9$k:]$K!"(Bskk-henkan-list $B$K(B #2 $B%(%s%H%j$H(B #3
  409.             ;; $B%(%s%H%j$,$"$l$P!"(B#2 $B$b$7$/$O(B #3 $B%(%s%H%j$N$&$A!"$h$j8eJ}$K$"$k(B
  410.             ;; $B$b$N$r>C$9!#(B
  411.             (setq e3 (if (consp e1) (car e1) e1))
  412.             ;; e3 $B$O(B "#2" $B$N$h$&$K?tCMJQ49$r<($9J8;zNs$N$_$H$O8B$i$J$$$N$G!"(B
  413.             ;; member $B$O;H$($J$$!#(B
  414.             (cond ((string-match "#2" e3)
  415.                    (setq type2 e1
  416.                          index2 n1
  417.                          head2 (substring e3 0 (match-beginning 0))
  418.                          tail2 (substring e3 (match-end 0)) ))
  419.                   ((string-match "#3" e3)
  420.                    (setq type3 e1
  421.                          index3 n1
  422.                          head3 (substring e3 0 (match-beginning 0))
  423.                          tail3 (substring e3 (match-end 0)) )))))
  424.         (if (and type2and3 type2 type3
  425.                  ;; $B?tCMJQ49$r<($9J8;zNs(B "#[23]" $B$NA08e$NJ8;zNs$bF10l$N$H(B
  426.                  ;; $B$-$N$_(B uniq $B$r9T$J$&!#(B
  427.                  (string= head2 head3) (string= tail2 tail3))
  428.             (if (> index2 index3)
  429.                 ;; "#3" $B$NJ}$,A0$K$"$k!#(B
  430.                 (setq skk-henkan-list (delq type2 skk-henkan-list))
  431.               ;; $BJQ?t(B type[23] $B$NCM$O!"(Bskk-henkan-list $B$+$iD>@\Cj=P$7$?$b(B
  432.               ;; $B$N$@$+$i(B delete $B$G$J$/!"(Bdelq $B$G==J,!#(B
  433.               (setq skk-henkan-list (delq type3 skk-henkan-list)) ))))))
  434.  
  435. ;;;###skk-autoload
  436. (defun skk-adjust-numeric-henkan-data (key)
  437.   (let (numexp orglen val)
  438.     (if (or (and (string-match "#[012349]" key)
  439.                  (setq numexp key) )
  440.             (and (setq numexp (skk-raw-number-to-skk-rep key))
  441.                  (not (string= key numexp)) ))
  442.         (progn
  443.           (setq orglen (length skk-henkan-list)
  444.                 ;; skk-henkan-list $B$ND4@0$O!"(Bskk-numeric-convert $B$NCf$G9T$J$C(B
  445.                 ;; $B$F$/$l$k!#(B
  446.                 val (skk-numeric-convert numexp) )
  447.           (if (= (length skk-henkan-list) (1+ orglen))
  448.               ;; #4 $B$GJ#?t$N8uJd$KJQ49$G$-$?>l9g$O3NDj$7$J$$!#(B
  449.               (setq skk-kakutei-flag t) ))
  450.       (setq skk-henkan-list (nconc skk-henkan-list (list key))
  451.             skk-kakutei-flag t
  452.             val key ))
  453.     val ))
  454.  
  455. ;;;###skk-autoload
  456. (defun skk-init-numeric-conversion-variables ()
  457.   ;; skk-use-numeric-convert $B4XO"$NJQ?t$r=i4|2=$9$k!#(B
  458.   (setq skk-num-list nil
  459.         skk-recompute-numerals-key nil ))
  460.  
  461. ;;;###skk-autoload
  462. (defun skk-numeric-midasi-word ()
  463.   ;; type4 $B$N?tCM:FJQ49$,9T$J$o$l$?$H$-$O!"?tCM<+?H$rJV$7!"$=$l0J30$N?tCMJQ49(B
  464.   ;; $B$G$O!"(Bskk-henkan-key $B$rJV$9!#$3$s$J>.$5$J4X?t$r:n$i$J$-$c$J$i$J$$$N$O!"(B
  465.   ;; skk-use-numeric-conversion $B$K4XO"$9$kJQ?t$r(B skk-num.el $B$K=8Ls$7$?L5M}$,=P(B
  466.   ;; $B$?7k2L$+(B...$B!#(B
  467.   (or skk-recompute-numerals-key skk-henkan-key) )
  468.  
  469. ;;;###skk-autoload
  470. (defun skk-update-jisyo-for-numerals (noconvword word &optional purge)
  471.   ;; $B?t;z<+?H$r8+=P$78l$H$7$F<-=q$N%"%C%W%G!<%H$r9T$J$&!#(B
  472.   (if (and skk-recompute-numerals-key
  473.            (save-match-data (string-match "#4" noconvword)) )
  474.       (let ((skk-henkan-key skk-recompute-numerals-key))
  475.     (message "%S" skk-recompute-numerals-key)
  476.         (skk-update-jisyo word purge) )))
  477.  
  478. ;;;###skk-autoload
  479. (defun skk-num (str)
  480.   ;; $B?t;z$r(B skk-number-style $B$NCM$K=>$$JQ49$9$k!#(B
  481.   ;; skk-date $B$N%5%V%k!<%A%s!#(B
  482.   (mapconcat (function
  483.           (lambda (c)
  484.         (cond ((or (not skk-number-style) (eq skk-number-style 0))
  485.                (char-to-string c) )
  486.               ((or (eq skk-number-style t) (eq skk-number-style 1))
  487.                (cdr (assq c skk-num-alist-type1)) )
  488.               (t (cdr (assq c skk-num-alist-type2))) )))
  489.          str "" ))
  490.  
  491. (run-hooks 'skk-num-load-hook)
  492.  
  493. (provide 'skk-num)
  494. ;;; skk-num.el ends here
  495.